17 Bit Software 6: Level 6/17 Bit - Level 6 (1998)(Epic Marketing)[!].iso/quartz/q0720.dms/q0720.adf/TP/TP.mod

Text File | 1992-03-07 | 5KB | 199 lines

(*---------------------------------------------------------------------------
    :Program.    TP.mod
    :Author.     Fridtjof Siebert
    :Address.    Nobileweg 67, D-7000-Stuttgart-40
    :Shortcut.   [fbs]
    :History.    V1.0, 07-Mar-92, [fbs], first public version
    :Copyright.  FD
    :Language.   Oberon
    :Translator. Amiga Oberon V2.30 (internal version)
    :Contents.   Programm zur statistischen Analyse des Rechenzeitbedarfs
    :Contents.   aller laufenden Tasks.
    :Usage.      SECS/N
    :Usage.      Der Parameter gibt die Anzahl der Sekunden an, die TP
    :Usage.      das System untersuchen soll. Je größer dieser Wert ist,
    :Usage.      desto genauer werden die ausgegebenen Werte.
---------------------------------------------------------------------------*)

(* $IFNOT SmallData  (SmallData will fail!) *)

MODULE TP;

IMPORT Dos, Exec, Strings, Hardware;

CONST
  TaskArraySize = 100;

VAR
  tasks: ARRAY TaskArraySize OF STRUCT
           task: Exec.TaskPtr;
           name: ARRAY 256-12 OF CHAR;
           cnt: LONGINT;
           cnt2: LONGINT;
         END;

  VertBIntr: Exec.InterruptPtr;  (* Meine Interrupt-Struktur         *)

  Count,Max,secs: LONGINT;
  numtasks: LONGINT;

  i: LONGINT;

  arga: ARRAY 1 OF Exec.APTR;
  liPtr: UNTRACED POINTER TO LONGINT;
  args: Dos.RDArgsPtr;

  Me : Exec.TaskPtr;

  string: Exec.STRING;

  acc,getacc: LONGINT;


PROCEDURE MyIntProc(); (* $SaveRegs+ $StackChk- *)

BEGIN

  i := 0;
  WHILE i<numtasks DO
    IF tasks[i].task=Exec.exec.thisTask THEN
      INC(tasks[i].cnt);
      i := numtasks
    END;
    INC(i);
  END;

  INC(Count);

  IF Count=Max DIV 2 THEN
    FOR i:=0 TO numtasks-1 DO
      tasks[i].cnt2 := tasks[i].cnt;
    END;
  END;

  IF Count=Max THEN Exec.Signal(Me,LONGSET{Dos.ctrlC}) END;

END MyIntProc; (* $StackChk= *)


PROCEDURE PrintPerCent(n: LONGINT);
BEGIN
(*
 * I do not know, how to do this better. Suggestions?
 *)
  Dos.PrintF("%ld%ld.%ld%ld %% ",n DIV 1000       ,
                                 n DIV 100  MOD 10,
                                 n DIV 10   MOD 10,
                                 n          MOD 10);
END PrintPerCent;


PROCEDURE GetTasks(task: Exec.TaskPtr);
BEGIN
  WHILE (task.node.succ#NIL) AND (numtasks<TaskArraySize) DO
    tasks[numtasks].task := task;
    IF task.node.name = NIL THEN
      tasks[numtasks].name := "unnamed";
    ELSE
      COPY(task.node.name^,tasks[numtasks].name);
    END;
    IF (Exec.process = task.node.type) AND (task(Dos.Process).cli#NIL) THEN
      Strings.Append(tasks[numtasks].name,": ");
      COPY(task(Dos.Process).cli.commandName^,string);
      string[ORD(string[0])+1] := 0X;
      Strings.Delete(string,0,1);
      Strings.Append(tasks[numtasks].name,string);
    END;
    task := task.node.succ;
    INC(numtasks);
  END;
END GetTasks;


BEGIN

  IF Dos.dos.lib.version<37 THEN HALT(20) END;

  args := Dos.ReadArgs("SECS/N",arga,NIL);

  IF args=NIL THEN

    IF Dos.PrintFault(Dos.IoErr(),NIL) THEN END;

  ELSE

    secs := 10;
    liPtr := arga[0];
    IF (liPtr#NIL) AND (liPtr^>0) THEN
      secs := liPtr^;
    END;
    Max := secs * LONG(Exec.exec.vblankFrequency);

    Exec.Forbid;
      numtasks := 0;
      GetTasks(Exec.exec.taskReady.head);
      GetTasks(Exec.exec.taskWait .head);
    Exec.Permit;

    Me := Exec.exec.thisTask;

    NEW(VertBIntr);

    IF VertBIntr=NIL THEN HALT(20) END;

    VertBIntr.node.type := Exec.interrupt; (* Typ ist Interrupt                *)
    VertBIntr.code := MyIntProc;           (* InterruptProzedur                *)

    Dos.PrintF("TP © 1992 by Fridtjof Siebert -- Freely Distributable\n\n"
               "Checking (%ld seconds)...\n\n",secs);

  (* Add interrupt and wait for ^C or secs *)

    Exec.AddIntServer(Hardware.vertb,VertBIntr);

    IF Exec.Wait(LONGSET{Dos.ctrlC})#LONGSET{} THEN END;

    Exec.RemIntServer(Hardware.vertb,VertBIntr);

    IF Count=Max THEN

  (* print cpu-usage percentages: *)

      FOR i := 0 TO numtasks-1 DO
        IF tasks[i].cnt#0 THEN
          PrintPerCent(tasks[i].cnt * 10000 DIV Count);
          Dos.PrintF(tasks[i].name);
          Dos.PrintF("\n");
        END;
      END;

  (* acc := sqrt( sum[i=0..numtasks-1] ((tasks[i].cnt - 2*tasks[i].cnt2) ^ 2) ) *)

      getacc := 0;
      FOR i := 0 TO numtasks-1 DO
        acc := tasks[i].cnt - 2*tasks[i].cnt2;
        INC(getacc,acc * acc);
      END;

      acc := 1;                     (* simple integer sqrt(): *)
      REPEAT
        acc := (acc + getacc DIV acc) DIV 2;
      UNTIL (acc*acc<=getacc) AND ((acc+1)*(acc+1)>getacc);

      Dos.PrintF("\naccuracy: ");
      PrintPerCent(acc * 10000 DIV Count);

    ELSE   (* IF Count=Max THEN ... *)

      Dos.PrintF("*** Break.");

    END;   (* IF Count=Max THEN ... ELSE ... *)

    Dos.PrintF("\n\nbye.\n");

  END;   (* IF args=NIL THEN ... ELSE ... *)

END TP.
(* $END *)